home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr26 / 4utils73.zip / DESCRIPT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-01  |  12KB  |  422 lines
  1. UNIT DescriptionHandling;
  2. {$L+,X+,V-}
  3. (* ----------------------------------------------------------------------
  4.    Part of 4DESC - A Simple 4DOS File Description Editor
  5.        and 4FF   - 4DOS File Finder
  6.  
  7.        David Frey,         & Tom Bowden
  8.        Urdorferstrasse 30    1575 Canberra Drive
  9.        8952 Schlieren ZH     Stone Mountain, GA 30088-3629
  10.        Switzerland           USA
  11.  
  12.        Code created using Turbo Pascal 7.0 (c) Borland International 1992
  13.  
  14.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  15.                and change it free of charge, but you may not sell or hire
  16.                this part of 4DESC. The copyright remains in our hands.
  17.  
  18.                If you make any (considerable) changes to the source code,
  19.                please let us know. (send a copy or a listing).
  20.                We would like to see what you have done.
  21.  
  22.                We, David Frey and Tom Bowden, the authors, provide absolutely
  23.                no warranty of any kind. The user of this software takes the
  24.                entire risk of damages, failures, data losses or other
  25.                incidents.
  26.  
  27.    This unit stores/retrieves the file data and descriptions by using
  28.    a TCollection (a Turbo Vision Object).
  29.  
  30.    ----------------------------------------------------------------------- *)
  31.  
  32. INTERFACE USES Objects, Dos, StringDateHandling;
  33.  
  34. CONST MaxDescLen = 42;
  35.       DirSize    = '  <DIR> ';
  36.  
  37. TYPE  NameExtStr = STRING[1+8+1+3];
  38.       SizeStr    = STRING[9];
  39.       DescStr    = STRING[MaxDescLen];
  40.       ProgInfo   = STRING;
  41.       SortKeyStr = STRING[14];
  42.  
  43. VAR   DescLong   : BOOLEAN;
  44.  
  45. TYPE  PFileData  = ^TFileData;
  46.       TFileData  = OBJECT(TObject)
  47.                     IsADir   : BOOLEAN;
  48.                     Name     : PString; (* ^NameExtStr; *)
  49.                     Size     : PString; (* ^SizeStr; *)
  50.                     Date     : PString; (* ^DateStr; *)
  51.                     Time     : PString; (* ^TimeStr; *)
  52.                     ProgInfo : PString; (* ^STRING; *)
  53.                     Desc     : PString; (* ^DescStr; *)
  54.                     SortKey  : PString; (* ^SortKeyStr; *)
  55.  
  56.                     CONSTRUCTOR Init(Search: SearchRec);
  57.                     DESTRUCTOR Done; VIRTUAL;
  58.  
  59.                     PROCEDURE AssignName(AName: NameExtStr);
  60.                     PROCEDURE AssignDesc(ADesc: DescStr);
  61.                     PROCEDURE AssignProgInfo(AProgInfo: STRING);
  62.  
  63.                     FUNCTION  GetDesc: DescStr;
  64.                     FUNCTION  GetSize: SizeStr;
  65.                     FUNCTION  GetName: NameExtStr;
  66.                     FUNCTION  GetProgInfo: STRING;
  67.  
  68.                     FUNCTION  FormatDescription: STRING;
  69.                    END;
  70.  
  71. CONST ListOK           = 0;
  72.       ListTooManyFiles = 1;
  73.       ListOutOfMem     = 2;
  74.  
  75. TYPE  PFileList  = ^TFileList;
  76.       TFileList  = OBJECT(TSortedCollection)
  77.                     Status      : BYTE;
  78.                     MaxFileLimit: INTEGER;
  79.  
  80.                     CONSTRUCTOR Init(Path: PathStr);
  81.  
  82.                     FUNCTION KeyOf(Item: POINTER): POINTER; VIRTUAL;
  83.                     FUNCTION Compare(key1,key2: POINTER): INTEGER; VIRTUAL;
  84.                    END;
  85.  
  86. VAR   FileList   : PFileList;
  87.  
  88. FUNCTION NILCheck(APtr: POINTER): POINTER;
  89.  
  90. IMPLEMENTATION USES Memory, DisplayKeyboardAndCursor, Drivers;
  91.  
  92. (* Allocate a 2KB text buffer for faster reads of DESCRIPT.ION *)
  93. VAR Buffer: ARRAY[1..2048] OF CHAR;
  94.  
  95. {$F+}
  96. FUNCTION HeapFunc(Size: WORD): INTEGER;
  97.  
  98. BEGIN
  99.  HeapFunc := 1;   (* Return nil if out of heap *)
  100. END;
  101. {$F-}
  102.  
  103. FUNCTION NILCheck(APtr: POINTER): POINTER;
  104.  
  105. (* Aborts when a NIL pointer has been detected. This prevents
  106.    deferencing a NIL pointer, which could be catastrophic
  107.    (spontaneous rebooting etc.)                               *)
  108.  
  109. BEGIN
  110.  IF APtr = NIL THEN Abort('NIL Pointer detected!')
  111.                ELSE NILCheck := APtr;
  112. END;
  113.  
  114. CONSTRUCTOR TFileData.Init(Search: SearchRec);
  115.  
  116. (* Constructor method. Constructs a FileData "object" on the heap
  117.    a fills in the appropriate values.                             *)
  118.  
  119. VAR TimeRec  : DateTime;
  120.     s        : STRING;
  121.     c        : CHAR;
  122.  
  123. BEGIN
  124.  TObject.Init;
  125.  
  126.  UnpackTime(Search.Time,TimeRec);
  127.  Name     := NIL; 
  128.  Date     := NIL; Date := NewStr(FormDate(TimeRec));
  129.  Time     := NIL; Time := NewStr(FormTime(TimeRec));
  130.  ProgInfo := NIL;
  131.  Desc     := NIL;
  132.  SortKey  := NIL;
  133.  
  134.  IsADir := (Search.Attr AND Directory = Directory);
  135.  IF IsADir THEN
  136.   BEGIN
  137.    s := DirSize;
  138.    c := '0';
  139.    UpString(Search.Name);
  140.   END
  141.  ELSE
  142.   BEGIN
  143.    IF FullSize THEN Str(Search.Size:8,s)
  144.                ELSE s := FormattedLongIntStr(Search.Size DIV 1024,7)+'K';
  145.    c := '1';
  146.   END;
  147.  
  148.  Size    := NewStr(s);
  149.  Name    := NewStr(Search.Name);
  150.  SortKey := NewStr(c + Search.Name);
  151.  (* Force directories ahead of files in sorted display. *)
  152. END;
  153.  
  154. DESTRUCTOR TFileData.Done;
  155.  
  156. (* Removes a FileData object from the heap. *)
  157.  
  158. BEGIN
  159.  DisposeStr(Date);     Date     := NIL;
  160.  DisposeStr(Time);     Time     := NIL;
  161.  DisposeStr(ProgInfo); ProgInfo := NIL;
  162.  DisposeStr(Desc);     Desc     := NIL;
  163.  DisposeStr(Name);     Name     := NIL;
  164.  DisposeStr(Size);     Size     := NIL;
  165.  DisposeStr(SortKey);  SortKey  := NIL;
  166.  
  167.  TObject.Done;
  168. END;
  169.  
  170. PROCEDURE TFileData.AssignName(AName: NameExtStr);
  171.  
  172. BEGIN
  173.  IF Name <> NIL THEN
  174.   BEGIN DisposeStr(Name); Name := NIL; END;
  175.  
  176.  Name := NewStr(AName);
  177.  IF (AName <> '') AND (Name = NIL) THEN
  178.   Abort('AssignName: NIL Pointer detected!')
  179. END;
  180.  
  181. PROCEDURE TFileData.AssignDesc(ADesc: DescStr);
  182.  
  183. BEGIN
  184.  IF Desc <> NIL THEN
  185.   BEGIN DisposeStr(Desc); Desc := NIL; END;
  186.  
  187.  Desc := NewStr(ADesc);
  188.  IF (ADesc <> '') AND (Desc = NIL) THEN
  189.   Abort('AssignDesc: NIL Pointer detected!')
  190. END;
  191.  
  192. PROCEDURE TFileData.AssignProgInfo(AProgInfo: STRING);
  193.  
  194. BEGIN
  195.  IF ProgInfo <> NIL THEN
  196.   BEGIN DisposeStr(ProgInfo); ProgInfo := NIL; END;
  197.  
  198.  ProgInfo := NewStr(AProgInfo);
  199.  IF (AProgInfo <> '') AND (ProgInfo = NIL) THEN
  200.   Abort('AssignProgInfo: NIL Pointer detected!')
  201. END;
  202.  
  203. FUNCTION TFileData.GetDesc: DescStr;
  204.  
  205. BEGIN
  206.  IF Desc <> NIL THEN GetDesc := Desc^
  207.                 ELSE GetDesc := '';
  208. END;
  209.  
  210. FUNCTION TFileData.GetSize: SizeStr;
  211.  
  212. BEGIN
  213.  IF Size <> NIL THEN GetSize := Size^
  214.                 ELSE GetSize := '';
  215. END;
  216.  
  217. FUNCTION TFileData.GetName: NameExtStr;
  218.  
  219. BEGIN
  220.  IF Name <> NIL THEN GetName := Name^
  221.                 ELSE GetName := '';
  222. END;
  223.  
  224. FUNCTION TFileData.GetProgInfo: STRING;
  225.  
  226. BEGIN
  227.  IF ProgInfo <> NIL THEN GetProgInfo := ProgInfo^
  228.                     ELSE GetProgInfo := '';
  229. END;
  230.  
  231. FUNCTION TFileData.FormatDescription: STRING;
  232.  
  233. VAR ia : ARRAY[0..4] OF PString;
  234.     s  : STRING;
  235.  
  236. BEGIN
  237.  ia[0] := Name;
  238.  ia[1] := Size;
  239.  ia[2] := Date;
  240.  ia[3] := Time;
  241.  ia[4] := Desc;
  242.  
  243.  FormatStr(s,' %-12s%s %s %s %s',ia);
  244.  FormatDescription := s;
  245. END;
  246.  
  247. CONSTRUCTOR TFileList.Init(Path: PathStr);
  248.  
  249. (* Build a list of FileData objects by inserting the directory entries
  250.    in a TSortedCollection.                                             *)
  251.  
  252. CONST CR      = #13;
  253.       LF      = #10;
  254.       EOFMark = #26;
  255.  
  256. VAR DescFileExists : BOOLEAN;
  257.     DescFound      : BOOLEAN;
  258.     DescFile       : TEXT;
  259.     DescLine       : STRING;
  260.     DescName       : NameExtStr;
  261.     DescStart      : BYTE;
  262.     DescEnd        : BYTE;
  263.     Desc           : STRING;
  264.     ProgInfo       : STRING;
  265.     sr             : SearchRec;
  266.     ListEntry      : PFileData;
  267.     mfl            : LONGINT;
  268.     c              : ARRAY[0..1] OF CHAR;
  269.     l              : BYTE;
  270.     Index          : INTEGER;
  271.     Key            : PString;
  272.     SKeyName       : SortKeyStr;
  273.  
  274. (***********************************************
  275.  FUNCTION HasDescription(AnEntry: PFileData): BOOLEAN; FAR;
  276.  BEGIN
  277.   IF AnEntry = NIL THEN HasDescription := FALSE
  278.                    ELSE HasDescription := (AnEntry^.GetName = DescName);
  279.  END;
  280. ************************************************)
  281.  
  282.  PROCEDURE DescSearch;
  283.  
  284.  BEGIN
  285.    Key := @SKeyName;
  286.    IF Search(Key,Index) THEN
  287.     BEGIN
  288.      DescEnd := Pos(#4,DescLine);
  289.      IF DescEnd = 0 THEN DescEnd := Length(DescLine)+1;
  290.      IF (DescEnd-1) - (DescStart+1) > MaxDescLen THEN DescLong := TRUE;
  291.      Desc := Copy(DescLine,DescStart+1,DescEnd-1);
  292.      StripLeadingSpaces(Desc);
  293.      StripTrailingSpaces(Desc);
  294.      ListEntry := At(Index);
  295.      ListEntry^.AssignDesc(Desc);
  296.      ProgInfo := Copy(DescLine,DescEnd,255);
  297.      ListEntry^.AssignProgInfo(ProgInfo);
  298.     END;
  299.  END;
  300.  
  301.  
  302.  PROCEDURE BeautifyEntries(AnEntry: PFileData); FAR;
  303.  
  304.  VAR s : NameExtStr;
  305.      p : BYTE;
  306.  
  307.  BEGIN
  308.   IF (AnEntry <> NIL) AND NOT AnEntry^.IsADir THEN
  309.    WITH AnEntry^ DO
  310.     BEGIN
  311.      s := GetName;
  312.      p := Pos('.',s);
  313.      IF p > 0 THEN
  314.       BEGIN
  315.        WHILE NOT NotLeftJust AND (p <> 9) AND (Length(s) < 13) DO
  316.          BEGIN
  317.            System.Insert(' ',s,p);
  318.            p := Pos('.',s);
  319.          END;
  320.        AssignName(s);
  321.       END;
  322.     END; (* with *)
  323.  END;
  324.  
  325. BEGIN
  326.  mfl := (MemAvail-2048) DIV SizeOf(POINTER);
  327.  IF mfl > MaxCollectionSize THEN MaxFileLimit := MaxCollectionSize
  328.                             ELSE MaxFileLimit := INTEGER(mfl);
  329.  
  330.  TCollection.Init(MaxFileLimit,0); Status := ListOK;
  331.  
  332.  FindFirst('*.*',ReadOnly+Archive+Directory+BYTE(UseHidden)*Hidden+SysFile, sr);
  333.  WHILE (DosError = 0) AND (Status = ListOK) AND (Count < MaxCollectionSize) DO
  334.   BEGIN
  335.    DownString(sr.Name);
  336.  
  337.    IF MemAvail < SizeOf(TFileData) THEN Status := ListOutOfMem
  338.    ELSE
  339.     BEGIN
  340.      ListEntry := NIL; ListEntry := New(PFileData,Init(sr));
  341.      IF ListEntry <> NIL THEN Insert(ListEntry)
  342.                          ELSE Status := ListOutOfMem;
  343.     END;
  344.  
  345.    FindNext(sr);
  346.   END; (* while *)
  347.  
  348.  IF Count = MaxFileLimit THEN Status := ListTooManyFiles;
  349.  
  350.  FindFirst('DESCRIPT.ION',Hidden + Archive,sr);
  351.  DescFileExists := (DosError = 0);
  352.  
  353.  IF DescFileExists THEN
  354.   BEGIN
  355.    {$I-}
  356.    Assign(DescFile,'DESCRIPT.ION');
  357.    SetTextBuf(DescFile,Buffer);
  358.    Reset(DescFile);
  359.    {$I+}
  360.    REPEAT
  361.     DescLine := '';
  362.     c[0] := #0;
  363.     REPEAT
  364.      c[1] := c[0];
  365.      Read(DescFile,c[0]);
  366.      DescLine := DescLine + c[0];
  367.     UNTIL ((c[0] = CR) AND (c[1] = LF)) OR
  368.            (c[1] = CR) OR
  369.            (c[1] = LF) OR
  370.            (c[1] = EOFMark);
  371.     l := Length(DescLine);
  372.     WHILE (DescLine[l] = CR) OR
  373.           (DescLine[l] = LF) OR
  374.           (DescLine[l] = EOFMark) DO
  375.      BEGIN
  376.        System.Delete(DescLine,l,1);
  377.        l := Length(DescLine);
  378.      END;
  379.  
  380.     DescStart := Pos(' ',DescLine);
  381.     IF DescStart = 0 THEN DescStart := Length(DescLine)+1;
  382.     DescName := Copy(DescLine,1,DescStart-1);
  383.     DownString(DescName);
  384.  
  385.     SKeyName := '1' + DescName;
  386.     DescSearch;                   (* File name search *)
  387.  
  388.     UpString(DescName);
  389.     SKeyName := '0' + DescName;
  390.     DescSearch;                   (* Directory name search *)
  391.  
  392.    UNTIL Eof(DescFile);
  393.    {$I-}
  394.    Close(DescFile);
  395.    {$I+}
  396.   END;
  397.  
  398.  ForEach(@BeautifyEntries);
  399. END; (* TFileList.Init *)
  400.  
  401. FUNCTION TFileList.KeyOf(Item: POINTER): POINTER;
  402.  
  403. BEGIN
  404.  KeyOf := PFileData(Item)^.SortKey;
  405. END; (* TFileList..KeyOf *)
  406.  
  407. FUNCTION TFileList.Compare(key1,key2: POINTER): INTEGER;
  408.  
  409. (* This function tells the sorted collection how to sort its members.
  410.    (by Name, directories first)                                       *)
  411.  
  412. BEGIN
  413.  IF PString(key1)^ = PString(key2)^ then Compare := 0
  414.   ELSE
  415.    IF PString(key1)^ < PString(key2)^ then Compare := -1
  416.      ELSE Compare := +1;
  417. END; (* TFileList.Compare *)
  418.  
  419. BEGIN
  420.  FileList := NIL; (* never leave a Pointer uninitialized ! *)
  421. END.
  422.